perm filename MPRX.FAI[RST,LCS] blob
sn#247701 filedate 1976-08-22 generic text, type T, neo UTF8
00100 TITLE MPRFAI
00200 ENTRY MPRFAI
00300 EXTERNAL DL,FRMT,.COMM.,XRN,ALF,STF,POSI,PTR,DPY,FONT,PLTR
00400 EXTERNAL PLOT,ALPHA,NOTWRT,METER,SLUR,NOTWRT,ROFF,RHORZ,RESET
00500 EXTERNAL ITMSUB,GETFI2,FASTI2,BMSTF,PLTSRT,TOOMCH,ENDIT,STAFF
00600 EXTERNAL KSIG,MAKNUM,CLEFS,UNKNWN,ILLEGL,CENTX,RUNTHR,PLTCMD
00700 ; IMPLICIT INTEGER(A-Q,S-Z)
00800 ; REAL DIS,DISX,A,B,STFF,CENTR,POS,BOT,TOP,TOP2,TOTAL
00900 ; COMMON /DL/IXRX,SAVER,NAME /FRMT/F78F(1),FA1(1),FA5(1),ASK
01000 ; COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
01100 ; ↓↓↓↓↓ V IS FOR READIN ONLY
01200 ; COMMON /XRN/RN(3000),V(1000) /ALF/INP(72),ML
01300 ; 1 /STF/RSTFAC(-3/4),RSTJ2 /POSI/STFF(-3/4),JJ2,POS
01400 ; 1 /PTR/PWDS(250),ITEM,L,I,M /DPY/GO,TOP,BOT /FONT/JFONT
01500 ; 1/PLTR/PLT,RHT,DIS
01600 ; EQUIVALENCE (J3,JQ(1)),(J5,JQ(3)),(R5,RJQ(3)),(POS,IPOS)
01700 ; 1,(R6,RJQ(4)),(R7,RJQ(5)),(R9,RJQ(7)),(J10,JQ(8)),(RX3,RJQ(20))
01800 ; 1,(R4,RJQ(2)),(R3,RJQ(1)),(I1,INP(1)),(R8,RJQ(6))
01900 ; DATA IP/'P'/,FA1/'( A1)'/
02000 MPRFAI: 0
02100 SETZM ITMS# ; ITMS=0
02200 SETZM TOTAL ; TOTAL=0
02300 MOVN [999.0] ; RPLT=-999.
02400 MOVEM RPLT# ; RPLT WILL BE FOR HEAVY STAFF LINES.
02500 ;;MP23: JSA 16,RESET ;23 TYPE 21
02600 ;; K# ;21 FORMAT(' RESET BOTTOM? '$)
02700 ;; MOVE K ; ACCEPT FA1,K
02800 ;; CAMN [ASCII/A /] ; IF(K.EQ.'A')GO TO 124
02900 ;; JRST MP124 ; IF(K.EQ.'P')GO TO 123
03000 ;TYPE 'P' FOR PRIM FONT ONLY. 'A' FOR ALL, IF RESET IS NEEDED.
03100 ;; CAMN [ASCII/P /]
03200 ;; JRST MP123
03300 ;; JRST MP24 ; GO TO 24
03400 ;;MP123: SETOM FONT ;123 JFONT=-1
03500 ;; JRST MP23 ;GO TO 23
03600 ;;MP124: SETZM FONT ;124 JFONT=0
03700 ;; JRST MP23 ; GO TO 23
03800 ;;MP24: CAMN [ASCII/N /] ;24 IF(K.EQ.'N')GO TO 22
03900 ;; JRST MP22 ; 'Y' OR <CR>=ABSOLUTE LOW POINT OF FILE WILL BE AT
04000 ; STARTING PEN POS.
04100 ; 'N'= BOTTOM OF STAFF 0 WILL BE AT STARTING PEN POS.
04200 MOVN [999.0] ; TOP2=-999
04300 MOVEM TOP2
04400 SETZM RNOMOV# ; RNOMOV=0
04500 MP22: SETZM ALF ;22 I1=0
04600 ;RESTART PROG. OR TYPE 'F' TO FINISH PLOTTER.(IT'S NOT AUTOMATIC.)
04700 MP2: MOVE [999.0] ;2 TOP=-999
04800 MOVNM DPY+1
04900 MOVEM DPY+2 ; BOT=999
05000 MP20: SETZM PLTR ;20 PLT=0
05100 SETZM PLOTIT# ; PLOTIT=0
05200 SETOM EDX# ; EDX=-1
05300 MOVEI 1 ; M=1
05400 MOVEM PTR+=253
05500 JRST MP5504 ; GO TO 5504
05600
05700
05800 MP11: JSA 16,NOTWRT ;11 CALL NOTWRT
05900 MP57: SKIPGE PLTR ;57 IF(PLT)GO TO 6120
06000 JRST MP6120
06100 AOS PTR+=250 ; ITEM=ITEM+1
06200 SKIPGE EDX ; IF(EDX.EQ.-1)GO TO 77
06300 JRST MP77
06400 MOVE PTR+=253 ; M IF(M.LT.I)GO TO 6120
06500 CAMGE PTR+=252 ; I
06600 JRST MP6120
06700 MP77: MOVN PLOTIT ;77 IF(PLOTIT.EQ.-2)GO TO 2311
06800 CAIN 2
06900 JRST MP2311
07000 MP5504: MOVE [ASCII/P /] ;5504 IF(I1.EQ.IP)GO TO 2311
07100 CAMN ALF
07200 JRST MP2311
07300 MOVEM ALF ; I1=IP
07400 MOVE [ASCII/X /] ; INP(2)='X'
07500 MOVEM ALF+1
07600 MP311: SETZM .COMM.+1 ;311 JA=0
07700 MP2311: SETZM NOSET
07800 JSA 16,PLTCMD ;2311 CALL PLTCMD
07900 NOSET#
08000 MOVN ALF+1 ; IF(INP(2).EQ.-1)GO TO 30
08100 CAIN 1
08200 JRST MP30 ; **** END OF DATA ***
08300 SKIPN PLOTIT ; IF(PLOTIT.EQ.0)GO TO 3005
08400 JRST MP3005
08500 MOVE [ASCII/P /] ; I1=IP
08600 MOVEM ALF
08700 SETOM PLOTIT ; PLOTIT=-1
08800
08900 MOVEI 1 ;6531 M=1
09000 MOVEM PTR+=253
09100 SETOM EDX ; EDX=-1
09200 SETZ 2, ; DO 5532 K=1,9
09300 MP5532: KIFIX .COMM.+4(2) ;5532 JQ(K)=RJQ(K)
09400 MOVEM .COMM.+=24(2)
09500 CAIE 2,=8
09600 AOJA 2,MP5532
09700 MOVNI 1 ; IF(PLOTIT.EQ.-1)GO TO 5121
09800 CAMN PLOTIT
09900 JRST MP5121
10000 MP590: SETZM ALF ;590 I1=0
10100 ; TO RUN THROUGH DATA.
10200 MOVE [999.0] ; TOP=-999
10300 MOVNM DPY+1
10400 MOVEM DPY+2 ; BOT=999
10500 ;GOES TO PLOTTER
10600 MP85: MOVEI 1 ;85 M=1
10700 MOVEM PTR+=253
10800 SETZM PTR+=250 ; ITEM=0
10900 MOVEM PLTR ;8852 PLT=1
11000 SETZM EDX ; EDX=0
11100 JRST MP6120 ; GO TO 6120
11200
11300 MP30: MOVE TOTAL ;30 A=TOTAL/200.0
11400 FDVR [200.0] ; TYPE 300,A,ITMS
11500 MOVEM K# ; CALL PLOT(0,0,99)
11600 JSA 16,ENDIT ; THE END OF THE DATA
11700 K ;300 FORMAT(F7.2,' INCHES',I,' ITEMS')
11800 ITMS#
11900
12000 MP60: KIFIX 2,.COMM. ;60 J2=R2
12100 MOVEM 2,.COMM.+3
12200 CAIL 2,5 ; IF(J2.LT.5)GO TO 16
12300 JRST MP160
12400 ;IF(J2.GT.-4)GO TO 16
12500 CAMLE 2,[-4] ; TYPE 160,J2
12600 JRST MP16
12700 MP160: JSA 16,ILLEGL ; GO TO 57
12800 .COMM.+3 ;160 FORMAT(' ILLEGAL STAFF# ',I4)
12900 JRST MP57
13000 MP16: MOVE STF+3(2) ;16 RSTJ2=RSTFAC(J2)
13100 MOVEM STF+10
13200 MOVE POSI+3(2)
13300 MOVEM POSI+11 ; 5541 POS=STFF(J2)
13400 MOVE .COMM.+1 ; IF(JA.NE.16)GO TO 61
13500 CAIE =16
13600 JRST MP61
13700 MOVE .COMM.+6 ; IF(R5.GE.100)R5=R5-100
13800 CAMGE [100.0] ;>100 FOR TEXT IN ORCH SCORES TO GO IN ALL SEP PARTS
13900 JRST .+3
14000 FSBR [100.0]
14100 MOVEM .COMM.+6 ; R5
14200 MOVE .COMM.+=31 ; IF(J10.NE.1)GO TO 62
14300 CAIE 1
14400 JRST MP62
14500 MOVE RWD3 ; R3=RWD3
14600 MOVEM .COMM.+4 ;C POSITIONS TEXT ITEMS.
14700 MP62: MOVE .COMM.+6 ;62 RWD3=R5*RSTJ2*R9+R3
14800 FMPR STF+10 ;RSTJ2
14900 FMPR .COMM.+=10 ;R9
15000 FADR .COMM.+4 ;R3
15100 MOVEM RWD3
15200 MP61: MOVE .COMM.+4 ;61 RX3=R3
15300 MOVEM .COMM.+=23
15400 JSA 16,RHORZ
15500 .COMM.+4 ; J3=ROFF(RHORZ(R3))
15600 JSA 16,ROFF ;C LINE IS DIVIDED INTO 200 POINTS.
15700 0
15800 KIFIX
15900 MOVEM .COMM.+=24 ; J3
16000 JSA 16,CENTX ; CALL CENTX
16100 FLTR .COMM.+=24 ; SETS VERT.(CENTR) POSITION BASED ON STAFF AND R4
16200 MOVEM .COMM.+4 ; R3=J3
16300 MOVE 2,.COMM.+1 ; IF(JA.LE.2)GO TO 11
16400 CAIL 2,=19 ;IF(JA.GT.18)CALL UNKNWN(JA)
16500 JRST MP5700
16600 JRST .@(2)
16700 MP11
16800 MP11
16900 MP68
17000 MP25
17100 MP67
17200
17300 MP625 ;JA=6
17400 MP116
17500 MP125
17600 MP11
17700 MP69 ;JA=10
17800
17900 MP68
18000 MP67
18100 TOTAL: 0 ;JA NEVER =13,14,15
18200 RWD3: 0
18300 TOP2: 0
18400 MP116
18500 MP81 ;JA=17
18600 ;551 GO TO(11,11,68,25,67, 625,116,125,11,69, 68,67),JA
18700 MP80
18800 MP80: JSA 16,METER ; GO TO (116,81,80),JA-15
18900 JRST MP57 ;C FOR 16,17,18 (WORDS, KSIG, METER)
19000 MP5700: JSA 16,UNKNWN ; TYPE 5700,JA
19100 .COMM.+1 ;5700 FORMAT(' UNKNOWN CODE=',I3)
19200 JRST MP57 ; GO TO 57
19300 ;TRAP FOR UNKNOWN CODE #S (SUCH AS 99-FOR "NO KSIG".
19400
19500 MP69: JSA 16,MAKNUM ;69 CALL MAKNUM(R5)
19600 .COMM.+6 ; GO TO 57
19700 JRST MP57
19800 MP68: JSA 16,CLEFS ;68 CALL CLEFS
19900 JRST MP57 ; GO TO 57
20000
20100 MP67: JSA 16,SLUR ;67 CALL SLUR
20200 JRST MP57 ; GO TO 57
20300
20400 MP116: JSA 16,ALPHA ;116 CALL ALPHA
20500 JRST MP57 ; GO TO 57
20600
20700 MP81: JSA 16,KSIG ;81 CALL KSIG
20800 JRST MP57 ; GO TO 57
20900 ;80 CALL METER
21000 ; GO TO 57
21100 MP125: SKIPE .COMM. ;125 IF(R2.EQ.0)RMOV=R8
21200 JRST .+3
21300 MOVE .COMM.+=9
21400 MOVEM RMOV#
21500 JSA 16,STAFF
21600 JRST MP57
21700 MP625: JSA 16,BMSTF ;625 CALL BMSTF
21800 ; BEAMS AND STAVES
21900 JRST MP57 ; GO TO 57
22000
22100 MP25: JSA 16,ITMSUB ;25 CALL ITMSUB
22200 ; BAR LINES AND SEVERAL OTHER KINDS OF LINES.
22300 JRST MP57 ; GO TO 57
22400
22500 MP3005: MOVN [999.0] ;3005 IF(RPLT.EQ.-999.)RPLT=R9
22600 CAME RPLT ;C R90⊃ FOR HEAVY STAFF LINES. (FOR XGP)
22700 JRST .+3
22800 MOVE .COMM.+=10
22900 MOVEM RPLT
23000 MOVNI 2 ; PLOTIT=-2
23100 MOVEM PLOTIT
23800 GETEM: JSA 16,GETFI2 ; CALL GETFI2(NAME,-1)
23900 DL+2 ;C JUMP TO READ BIG FILES
24000 [-1]
24100 JSA 16,FASTI2 ; CALL FASTI2(RSTFAC,128)
24200 STF
24300 [128]
24400 JSA 16,FASTI2 ; CALL FASTI2(PWDS,JJ2)
24500 PTR
24600 POSI+10
24700 JSA 16,FASTI2 ; CALL FASTI2(RN,IPOS)
24800 XRN
24900 POSI+11
25000 MOVE POSI+10 ; ITEM=JJ2-2
25100 SUBI 2
25200 MOVEM PTR+=250
25300 ADDM ITMS ; ITMS=ITMS+ITEM
25400 MOVE POSI+11 ; I=IPOS
25500 MOVEM PTR+=252
25600 CAIG =2000 ;2203 IF(I.LE.2000)GO TO 590
25700 JRST MP590
25800 JSA 16,TOOMCH ; TYPE 4202,I
25900 POSI+11 ; STOP
26000 ;4202 FORMAT(' ***** TOO MUCH DATA ',I4,'/2000')
26100 MP121: SKIPN PLOTIT ;121 IF(PLOTIT.EQ.0)GO TO 5504
26200 JRST MP5504
26300 MP5121: JSA 16,PLTSRT ;5121 CALL PLTSRT
26400 SETOM PLTR ;IF P5=0 MOVES UP AT START, IF P6=0 MOVES UP AT END.
26500 SKIPN RPLT ; PLT=-1
26600 JRST .+3 ; IF(RPLT.NE.0)PLT=-2
26700 MOVNI 2 ;C (J8) P8=1 OR 2 FOR 2-PASS PLOTS
26800 MOVEM PLTR
26900 SKIPE 2,.COMM. ;; CALL NOZERO(R2)
27000 JRST .+3
27100 MOVE 2,[1.0]
27200 MOVEM 2,.COMM.
27300 FMPR 2,[1.24] ; DIS=R2*1.24
27400 MOVEM 2,PLTR+2
27500 MOVE .COMM.+4 ; RHT=R3*1.2
27600 FMPR [1.2] ;1.24 AND 1.2 ARE TO FIT 8 1/2 X 11 FORMAT
27700 MOVEM PLTR+1
27800 FMPR DPY+2 ;A=BOT*RHT
27900 MOVEM A# ;??????
28000 MOVNM DPY+2 ; BOT=-A
28100 MOVE PLTR+1 ; TOTAL=TOTAL+BOT+TOP*RHT
28200 FMPR DPY+1
28300 FADR DPY+2
28400 FADRM TOTAL
28500 MOVN [999.0] ; IF(TOP2.EQ.-999)GO TO 8121
28600 CAMN TOP2
28700 JRST MP8121
28800 MOVE 2,TOP2 ; BOT=BOT+TOP2
28900 FADRM 2,DPY+2
29000 SKIPN TOP2 ; IF(TOP2.EQ.0)BOT=0
29100 SETZM DPY+2
29200 MOVE DPY+2
29300 MOVEM A ; A=BOT
29400 JRST MP9121 ; GO TO 9121
29500 MP8121: SETZM RNOMOV ;8121 RNOMOV=0
29600 MP9121: SKIPE .COMM.+=8 ;9121 IF(R7.EQ.0)R7=RMOV
29700 JRST .+3 ;RMOV HAS INCHES FROM P8 OF STAFF 0.
29800 MOVE RMOV
29900 MOVEM .COMM.+=8
30000 MOVE RNOMOV ; IF(RNOMOV.GT.1)BOT=RNOMOV
30100 CAMLE [1.0]
30200 MOVEM DPY+2
30300 MOVE [200.0] ; RNOMOV=R6+R7*200.*R3
30400 FMPR .COMM.+4
30500 FMPR .COMM.+=8
30600 FADR .COMM.+7
30700 MOVEM RNOMOV#
30800 SETZM RMOV ; RMOV=0
30900 ; R6=1 FOR NO MOVE AT END. R7=# OF INCHES TO MOVE FOR NEW STAFF 0.
31000 SKIPE .COMM.+=26 ;C (J4) P4=1 FOR XGP OUTPUT
31100 JRST MP6120 ; IF(J5.NE.0)GO TO 6120
31200 KIFIX DPY+2 ;C MOVES 0 POINT OVER EACH TIME.
31300 MOVEM K ;6121 CALL PLOT(0,IFIX(BOT),-3)
31400 JSA 16,PLOT ;C MOVES PLOTTER UP IF P5=0.
31500 [0]
31600 K
31700 [-3]
31800
31900 MP6120: MOVE PTR+=253 ;C NEXT RUNS THROUGH DATA WITH NEW CHANGES.
32000 CAML PTR+=252 ;6120 IF(M.GE.I)GO TO 7120
32100 JRST MP7120 ; CALL RUNTHR(M)
32200 JSA 16,RUNTHR ; GO TO 60
32300 PTR+=253
32400 JRST MP60
32500 MP7120: MOVEI 1 ;7120 M=1
32600 MOVEM PTR+=253
32700 MOVE [50.0] ;71201 A=50.*RHT
32800 FMPR PLTR+1
32900 MOVEM A
33000 MOVE PLTR+1 ; TOP=TOP*RHT
33100 FMPRM DPY+1
33200 SKIPN RNOMOV ; IF(RNOMOV.EQ.0)GO TO 7122
33300 JRST MP7122
33400 SETZM A ; A=0
33500 MP7121: MOVE RNOMOV ;7121 IF(RNOMOV.LE.1)GO TO 7123
33600 CAMG [1.0]
33700 JRST MP7123
33800 MOVEM A ; A=RNOMOV
33900 FSBR DPY+1 ; TOTAL=TOTAL+A-TOP
34000 FADRM TOTAL
34100 JRST MP7123 ; GO TO 7123
34200 MP7122: MOVE A ;7122 TOTAL=TOTAL+A
34300 FADRM TOTAL
34400 FADR DPY+1 ; A=A+TOP
34500 MOVEM A
34600 MP7123: KIFIX A ;7123 CALL PLOT(0,IFIX(A),3)
34700 MOVEM K
34800 JSA 16,PLOT
34900 [0]
35000 K
35100 [3]
35200 MOVE RNOMOV ; IF(RNOMOV.EQ.1)GO TO 20
35300 CAMN [1.0] ;C PRESERVES TOP AND BOT IF RNOMOV
35400 JRST MP20
35500 MOVE A ; TOP=A
35600 MOVEM DPY+1
35700 MOVEM TOP2 ; TOP2=TOP
35800 JRST MP2 ; GO TO 2
35900 ; TO MOVE 'PLOTTER' FOR XGP OUTPUT
36000 ; MOVES PLOTTER UP
36100 ; ALWAYS START PLOT WITH BOTTOM UNIT ON PAGE AND WORK UP.
36200
36300 END